ERASE SOURCE.TST1$$
FTN TST1$$,N
      DIMENSION F(3,3),NF(2),G(3,3),NG(2),H(2,3),NH(2),B(3,3),
     XNB(2),C(3,3),NC(2),X0(3),NX0(2),XT(3),NXT(2),V1(3),NV1(2),
     XV2(3),NV2(2),A1(3,3),NA1(2),U(3),NU(2),YT(3),NYT(2),W(18)
      DOUBLE PRECISION F,G,H,B,C,X0,U,XT,YT,TT,DELTAT,TFINAL,V1,V2,A1,W
      COMMON /MAX/ MAXRC
      COMMON  /LINES/NLP,LIN,TITLE(23)
      MAXRC=9
      CALL RDTITL
      READ (5,100) TT,DELTAT,TFINAL
  100 FORMAT (8F10.2)
      CALL READ (5,F,NF,G,NG,H,NH,U,NU,X0,NX0)
  101 FORMAT(1H0 59X, 'TIME RESPONSE',/' TIME',22X,'STATE',54X,
     1 'OUTPUT',/' TT',14X,'XT(1)',11X,'XT(2)',11X,'XT(3)',21X,'YT(1)',
     1 11X,'YT(2)',11X,'YT(3)')
  102 FORMAT(1H0 F10.2,6X,3E16.7,10X,3E16.7)
      CALL LNCNT (4)
      WRITE(6,101)
   10 CALL EAT (F,NF,TT,B,NB,C,NC,W,18)
      CALL MULT(B,NB,X0,NX0,V1,NV1)
      CALL MULT(C,NC,G,NG,A1,NA1)
      CALL MULT(A1,NA1,U,NU,V2,NV2)
      CALL ADD(V1,NV1,V2,NV2,XT,NXT)
      CALL MULT(H,NH,XT,NXT,YT,NYT)
      CALL LNCNT (2)
      WRITE(6,102) TT,(XT(I),I=1,3),(YT(I),I=1,2)
      TT=TT+DELTAT
      IF(TT.GT.TFINAL)  STOP
      GO TO 10
      END
SAMPLE MAIN PROGRAMS AND TEST CASES FOLLOW0
ERASE SOURCE.CKTRNS$$
FTN CKTRNS$$,BCD=Y
      DIMENSION F(5,5),NF(2),G(5,2),NG(2),J(2,1),NJ(2),R(1,1),NR(2),K(2,
     15),NK(2),H(7,5),NH(2),X(5),NX(2),T(4),NT(2),DUMMY(100)
      DOUBLE PRECISION F,G,J,R,K,H,X,T,DUMMY
      COMMON/FORM/NEPR,FMT1(6),FMT2(6)
      CALL RDTITL
      CALL READ(5,F,NF,G,NG,J,NJ,R,NR,K,NK)
      CALL READ(3,H,NH,X,NX,T,NT)
      CALL TRNSI(F,NF,G,NG,J,NJ,R,NR,K,NK,H,NH,X,NX,T,DUMMY,100)
      STOP
      END
ERASE SOURCE.TST2A$$
FTN TST2A$$,N
      DIMENSION NF(2),NG(2),NFSTAR(2),NC(2),NCK(2),NQ(2),NR(2),NRI(2),
     1 NZ(2),NPHI(2),NP0(2),NPT(2),NX0(2),NXT(2),NA1(2),NA2(2),NH(2),
     2 NDELTC(2),NXX(2),NCONT(3),LAB(2),L(3)
      DOUBLE PRECISION Q(3,3),R(1,1),RI(1,1),F(3,3),G(3,1),FSTAR(3,3),
     1 C(1,3),CK(1,3),Z(6,6),PHI(6,6),P0(3,3),PT(3,3),X0(3),XT(3),XX(3),
     2 DELTC(1),H(3,3),A1(3,3),A2(3,3),DUMMY(72),TT,DELT1,DELT2,TFINAL,
     2 DET
      COMMON  /MAX/MAXRC
      CALL RDTITL
      MAXRC=36
      KDUM=72
      READ(5,100) TT,DELT1,DELT2,TFINAL
      CALL READ  (5,F,NF,G,NG,X0,NX0,H,NH,Q,NQ)
      CALL READ  (2,R,NR,P0,NP0,R,NR,R,NR,R,NR)
  100 FORMAT(8F10.2)
  101 FORMAT(1H  59X, 'TIME RESPONSE'/5X,' TIME',22X,'STATE',43X,
     1 'OUTPUT'/5X' TT',14X,'XT(1)',11X,'XT(2)',11X,'XT(3)',21X,'DELTC')
  102 FORMAT(1H  F10.2,6X,3E16.7,10X,2E16.7,10X,E16.7)
      NCONT(1)=1
      NCONT(2)=IDINT(TFINAL/DELT1)+1
      NCONT(3)=4
      CALL EQUATE(X0,NX0,XT,NXT)
      CALL EQUATE(P0,NP0,PT,NPT)
      CALL EQUATE(R,NR,RI,NRI)
      CALL INV(RI,NRI   ,DET,L)
      CALL AUG(F,NF,G,NG,RI,NRI,H,NH,Q,NQ,C,NC,Z,NZ,1)
      CALL ETPHI(Z,NZ,DELT1,PHI,NPHI,DUMMY,KDUM)
      CALL RICAT(PHI,NPHI,C,NC,NCONT,CK,NCK,PT,NPT,DUMMY,KDUM)
      CALL MULT(G,NG,CK,NCK,A1,NA1)
      CALL SCALE(A1,NA1,A2,NA2,-1.D0)
      CALL ADD(F,NF,A2,NA2,FSTAR,NFSTAR)
      CALL PRNT  (FSTAR,NFSTAR,'FSTR',1)
      CALL ETPHI(FSTAR,NFSTAR,DELT2,A2,NA2,DUMMY,KDUM)
      CALL LNCNT(2)
      WRITE  (6,106)
  106 FORMAT  ('0 TRANSITION MATRIX')
      CALL PRNT  (A2,NA2,'  A2',1)
      CALL LNCNT(100)
      CALL LNCNT(3)
      WRITE(6,101)
      CALL MULT(CK,NCK,XT,NXT,DELTC,NDELTC)
      DELTC(1)=-1.0*DELTC(1)
      CALL LNCNT(1)
      WRITE(6,102) TT,XT,DELTC
  200 CALL EQUATE(XT,NXT,XX,NXX)
      CALL MULT(A2,NA2,XX,NXX,XT,NXT)
      CALL MULT(CK,NCK,XT,NXT,DELTC,NDELTC)
      DELTC(1)=-1.*DELTC(1)
      TT=TT+DELT2
      WRITE(6,102) TT,XT,DELTC
      IF(TT.GE.TFINAL)  STOP
      GO TO 200
      END
ERASE SOURCE.CKSMPL$$
FTN CKSMPL$$,N
C     CHECK PROCEDURE FOR SAMPLE  SEE PAGES 234 AND 244 OF ASP MANUAL
      DIMENSION  NPHI(2),NQ(2),NR(2),NP(2),NK(2),NCONT(3),NH(2)
      DOUBLE PRECISION  PHI(3,3),H(3,2),Q(3,3),R(2,2),P(3,3),K(3,2),
     1                  DUM(54)
      COMMON  /MAX/MAXRC
      MAXRC=9
      NDUM=54
      CALL RDTITL
   10 CALL READ   (4,PHI,NPHI,H,NH,Q,NQ,R,NR,R,NR)
      NP(1)=NPHI(1)
      NP(2)=NPHI(2)
      CALL UNITY  (P,NP)
      NCONT(1)=1
      NCONT(2)=4
      NCONT(3)=4
      CALL SAMPL  (PHI,NPHI,H,NH,Q,NQ,R,NR,P,NP,K,NK,NCONT,DUM,NDUM)
      CALL EXIT
      GO TO 10
      END
ERASE SOURCE.CKDECO$$
FTN CKDECO$$,N
C     MAIN PROGRAM TO CHECK DECOM ET AL
      DIMENSION   NZL(2),NT(2),NEXR(2),NR(2),NG(2),NH(2),ND(2),NR1(2),
     1  NRE(2),NEXC(2)
      DOUBLE PRECISION ZL(100),T(100),EXR(100),R(100),G(100),H(100),
     1   DUM(700),R1(100),RE(100),EXC(100)
      COMMON  /MAX/MAXRC
      MAXRC=100
      KDUM=700
   20 CALL RDTITL
      CALL READ  (4,ZL,NZL,T,NT,EXR,NEXR,EXC,NEXC,T,NT)
      CALL ORTH  (T,NT,DUM,KDUM)
      M=NT(1)
      M2=M*M+1
      MS=M*M
      M3=M2+MS
      M4=M3+MS
      M5=M4+MS
      M6=M5+MS
      M7=M6+MS
      DUM(M7) =ZL(2)
      CALL MULT  (T,NT,ZL,NZL,DUM(M3),ND)
      CALL MULT  (DUM(M3),ND,DUM(M2),ND,ZL,NZL)
      IF (NZL(1).NE.NEXC(1))GO TO 30
      CALL JUXTC (ZL,NZL,EXC,NEXC,R,NR)
      GO TO 50
   30 IF (NZL(2) .NE.NEXR(2))GO TO 40
      CALL JUXTR (ZL,NZL,EXR,NEXR,R,NR)
      GO TO 50
   40 CALL EQUATE(ZL,NZL,R,NR)
      IF  (DUM(M7).NE.0.D0)   GO TO 50
      CALL DECSYM (R,NR,G,NG,H,NH,DUM,KDUM)
      GO TO 70
   50 CALL DECGEN(R,NR,G,NG,H,NH,DUM,KDUM)
   70 CALL MULT  (H,NH,G,NG,R1,NR1)
      CALL SUBT  (R,NR,R1,NR1,RE,NRE)
      CALL PRNT (R,NR,'R   ',1)
      CALL PRNT (R1,NR1,'R1  ',1)
      CALL PRNT (RE,NRE,'RERR',1)
      CALL PRNT (H ,NH ,'H   ',1)
      CALL PRNT (G ,NG ,'G   ',1)
      ND(1)=1
      ND(2)=1
      CALL PRNT (DUM(M6),ND,'RANK',1)
      GO TO 20
      END
ERASE SOURCE.ORTH$$
FTN ORTH$$,N
      SUBROUTINE  ORTH  (T,NT,DUM,KDUM)
      DOUBLE PRECISION T(1),DUM(1),CTH,STH
      DIMENSION NT(2)
      LDM2=2*NT(1)**2+1
   10 LDM1=NT(1)**2+1
      N=NT(1)
      CALL UNITY (DUM(LDM1),NT)
      NM=NT(1)-1
      DO 20 J=1,NM
      JP=J+1
      DO 20 I=JP,N
      CALL UNITY (DUM,NT)
      II=N*(I-1)+I
      JJ=N*(J-1)+J
      IJ=N*(I-1)+J
      JI=N*(J-1)+I
      CTH=DCOS(T(IJ))
      STH=DSIN(T(IJ))
      DUM(II)=CTH
      DUM(JJ)=CTH
      DUM(IJ)=STH
      DUM(JI)=-STH
      CALL MULT (DUM(LDM1),NT,DUM,NT,DUM(LDM2),NT)
      CALL EQUATE (DUM(LDM2),NT,DUM(LDM1),NT)
   20 CONTINUE
      CALL TRANP (DUM(LDM1),NT,T,NT)
      CALL MULT (T,NT,DUM(LDM1),NT,DUM(LDM2),NT)
      CALL PRNT (T,NT,4HT   ,1)
      CALL PRNT (DUM(LDM2),NT,4HT*T',1)
      RETURN
      END
ERASE SOURCE.CKPSEU$$
FTN CKPSEU$$,N
      DIMENSION A(50),B(50),W(350),NA(2),NB(2),A1(50),A2(50),NA1(2),
     1 NA2(2),LAB(2)
      DOUBLE PRECISION A,B,W,A1,A2
      COMMON  /MAX/MAXRC
      MAXRC=50
    5 CALL RDTITL
      CALL READ   (1,A,NA,A,NA,A,NA,A,NA,A,NA)
      NW=350
      CALL PSEUDO(A,NA,B,NB,W,NW)
      CALL PRNT  (B,NB,'APSE',1)
      CALL MULT(A,NA,B,NB,A1,NA1)
      CALL MULT(A1,NA1,A,NA,A2,NA2)
      CALL SCALE(A,NA,A1,NA1,-1.D0)
      CALL ADD(A1,NA1,A2,NA2,A1,NA1)
      CALL PRNT  (A2,NA2,'AASA',1)
      CALL PRNT  (A1,NA1,'AERR',1)
      CALL MULT(B,NB,A,NA,A1,NA1)
      CALL MULT(A1,NA1,B,NB,A2,NA2)
      CALL SCALE(B,NB,A1,NA1,-1.D0)
      CALL ADD(A1,NA1,A2,NA2,A1,NA1)
      CALL PRNT  (A2,NA2,'ASAA',1)
      CALL PRNT  (A1,NA1,'AERR',1)
      GO TO 5
      END
